﻿namespace InkType.ViewModel

open InkType.ViewModel.SavedTypefaces
open System
open System.Collections.Generic
open System.Collections.ObjectModel
open System.Text
open System.Text.RegularExpressions
open System.Windows
open System.Windows.Controls
open System.Windows.Ink
open System.Windows.Input
open System.Windows.Media


type FontName (name : string) =
    static let pattern = @"^[a-zA-Z0-9!#@&';,_~\.\^\-\+\$]+$"

    let () =
        if not (Regex.IsMatch (name, pattern)) then
            invalidArg "name" (sprintf @"Name must match pattern ""%s""" pattern)

    member x.Name = name

    static member Pattern = pattern

    static member IsValidName name =
        Regex.IsMatch (name, pattern)

    static member val StringConverter =
        ValueConverter.CreateB (
            Func<FontName, _> (fun fname -> fname.Name),
            Func<_, _> (fun n -> FontName (n)))


type FontNameValidationRule () =
    inherit ValidationRule ()

    override x.Validate (value, _) =
        match value with
        | null ->
            ValidationResult (false, "Value is null.")
        | :? string as value when FontName.IsValidName value ->
            ValidationResult (true, null)
        | :? string ->
            ValidationResult (false, sprintf @"Name must match pattern ""%s""" FontName.Pattern)
        | _ ->
            ValidationResult (false, "Value is not a string instance.")


module Otf =
    open Microsoft.Win32
    open System.Diagnostics
    open System.IO
    open System.Runtime.InteropServices

    let ffdir = @"C:\Program Files (x86)\FontForgeBuilds\"

    let () =
        Environment.SetEnvironmentVariable ("FF", ffdir)
        let path = Environment.GetEnvironmentVariable "PATH"
        let path = sprintf "%s;%s" ffdir path
        let path = sprintf "%s;%s" (Path.Combine (ffdir, "bin")) path
        Environment.SetEnvironmentVariable ("PATH", path)
        Environment.SetEnvironmentVariable ("FF_PATH_ADDED", "TRUE")

    let private ffpythonDialog =
        let dialog = OpenFileDialog ()
        dialog.Filter <- "ffpython.exe|ffpython.exe"
        dialog.Title <- "Locate FontForge Python Shell"
        dialog

    let private saveOtfDialog =
        let dialog = SaveFileDialog ()
        dialog.Filter <- "OpenType Font File|*.otf"
        dialog.Title <- "Generate OTF File"
        dialog

    let generate dialogOwner (fontName : FontName) (glyphs : seq<GlyphViewModel>) =
        let _ = ffpythonDialog.ShowDialog dialogOwner
        let ffpythonLocation = ffpythonDialog.FileName

        let _ = saveOtfDialog.ShowDialog dialogOwner
        let pwd = Path.GetDirectoryName saveOtfDialog.FileName
        let fileName = saveOtfDialog.SafeFileName

        let ffpython =
            //let psi = ProcessStartInfo ("ffpython", "-i")
            let psi = ProcessStartInfo (ffpythonLocation, "-i")
            psi.UseShellExecute <- false
            //psi.WorkingDirectory <- @"C:\Users\User\Desktop"
            psi.WorkingDirectory <- pwd
            psi.RedirectStandardInput <- true
            //psi.RedirectStandardOutput <- true
            //psi.RedirectStandardError <- true
            new Process (StartInfo = psi)

        let onReceiveData =
            fun (e : DataReceivedEventArgs) ->
                Console.WriteLine e.Data

        //ffpython.OutputDataReceived.Add onReceiveData
        //ffpython.ErrorDataReceived.Add onReceiveData
        ffpython.Start () |> ignore
        //ffpython.BeginOutputReadLine ()
        //ffpython.BeginErrorReadLine ()

        let send (format : Printf.StringFormat<_, _>) =
            Printf.kprintf ffpython.StandardInput.WriteLine format

        send ""

        send "import os"
        send "import sys"
        send "import fontforge"

        let tolerance = 0.2

        send "f = fontforge.font()"

        glyphs
        |> Seq.iter (fun glyph ->
            let pg =
                let pg =
                    glyph.StrokeCollection
                    |> Seq.map (fun stroke -> stroke.GetGeometry ())
                    |> Seq.fold (fun pg g ->
                        Geometry.Combine (pg, g, GeometryCombineMode.Union, Transform.Identity, tolerance, ToleranceType.Absolute))
                        (new PathGeometry ())
                pg.Transform <-
                    let t = TransformGroup ()
                    t.Children.Add (TranslateTransform (-GlyphMetrics.BorderOverflow, -GlyphMetrics.BorderOverflow))
                    t.Children.Add (ScaleTransform (1000. / GlyphMetrics.Height, 1000. / GlyphMetrics.Height))
                    t.Children.Add (ScaleTransform (1., -1.))
                    t.Children.Add (TranslateTransform (0., 800.))
                    t
                pg.GetFlattenedPathGeometry (tolerance, ToleranceType.Absolute)
            send "k = f.createChar(%d)" glyph.CharCode
            send "k.width = %f" (glyph.GlyphWidth * 5.)
            send "k.manualHints = 1"
            send "k"
            send "p = k.glyphPen()"

            pg.Figures
            |> Seq.iter (fun figure ->
                let moveTo =
                    let point = figure.StartPoint
                    sprintf ".moveTo((%f, %f))" point.X point.Y
                let lineTo's =
                    figure.Segments
                    |> Seq.collect (
                        function
                        | :? LineSegment as segment -> seq { yield segment.Point }
                        | :? PolyLineSegment as segment -> segment.Points :> _
                        | _ -> invalidArg "figure" "Segments contains curves." )
                    |> Seq.map (fun point ->
                        sprintf ".lineTo((%f, %f))" point.X point.Y)
                    |> String.concat ""
                send "p%s%s.closePath()" moveTo lineTo's))
            //send "k.draw(p)")

        send "f.fontname = '%s'" fontName.Name
        send "f.familyname = '%s'" fontName.Name
        send "f.fullname = '%s'" fontName.Name
        send "f.os2_unicoderanges = (-1, -1, -1, -1)"       // for some reason these two won't work
        send "f.os2_codepages = (-1, -1)"
        //send "f.generate('%s.otf', flags=('opentype', 'dummy-dsig'))" fontName.Name
        send "f.generate('%s', flags=('opentype', 'dummy-dsig'))" fileName
        send "exit()"

        ffpython.WaitForExit ()


type [<AllowNullLiteral>] TypefaceViewModel private (model, dc, characterBlocks, __) =
    inherit DependencyObject ()

    let glyphList = lazy GlyphListViewModel (model, dc, characterBlocks)

    static member val NameProperty =
        Dp.reg<FontName, TypefaceViewModel> "Name"
            (Dp.Meta (FontName ("NewTypeface")))

    static member val TimestampProperty =
        Dp.reg<int64, TypefaceViewModel> "Timestamp"
            (Dp.Meta (0L))

    new (model, dc, characterBlocks) as x =
        TypefaceViewModel (model, dc, characterBlocks, ())
        then
            x.Name <- FontName (model.Name)
            x.Timestamp <- BitConverter.ToInt64 (model.Timestamp.ToArray (), 0)

    member x.Name
        with get () = x.GetValue TypefaceViewModel.NameProperty :?> FontName
        and set (v : FontName) = x.SetValue (TypefaceViewModel.NameProperty, box v)

    member x.Timestamp
        with get () = x.GetValue TypefaceViewModel.TimestampProperty :?> int64
        and set (v : int64) = x.SetValue (TypefaceViewModel.TimestampProperty, box v)

    member internal x.Model = model

    member x.GlyphList = glyphList.Force ()

    member internal x.UpdateTimestamp () =
        model.Name <- model.Name
        dc.DataContext.SubmitChanges ()

        x.Timestamp <- BitConverter.ToInt64 (model.Timestamp.ToArray (), 0)

    member x.GenerateOtfCommand =
        fun dialogOwner ->
            Otf.generate dialogOwner x.Name (glyphList.Force ()).DefinedGlyphs
        |> Command.RelayP

    member x.OnExit () =
        model.Name <- x.Name.Name
        dc.DataContext.SubmitChanges ()

        (glyphList.Force ()).OnExit ()



